home *** CD-ROM | disk | FTP | other *** search
/ Deutsche Edition 1 / Deutsche Edition 1.iso / amok / 041-050 / amok49 / oprof / txt / oprof.mod < prev    next >
Text File  |  1993-11-04  |  8KB  |  305 lines
  1. (*
  2.   :Program.       OProf.mod (OProf)
  3.   :Author.        Volker Rudolph
  4.   :Address.       Lettow-Vorbeck-Str. 11 / 6750 Kaiserslautern 26
  5.   :Phone.         06301/8566
  6.   :Version.       1.22
  7.   :Date.          4.11.90
  8.   :Copyright.     Volker Rudolph (Shareware)
  9.   :Language.      Oberon
  10.   :Translator.    Oberon V1.17.1
  11.   :Imports.       MicroTimer, Printf
  12.   :Contents.      Laufzeit-Statistiken über Programme
  13. *)
  14.  
  15. MODULE OProf;
  16.  
  17. IMPORT a:Arguments,as:ASCII,Break,NoGuru,st:Strings,p:Printf,io,l:Lists,s:SYSTEM,
  18.        ex:Expressions,te:Text,pr:ProfRunTime;
  19.  
  20. CONST
  21.   DEBUG = FALSE;
  22.  
  23. TYPE
  24.   CHARPtr = POINTER TO CHAR;
  25.  
  26. VAR
  27.   trace:INTEGER;
  28.  
  29. (* ------------------------------------------------------------------------- *)
  30.  
  31. PROCEDURE HashValue(VAR proc:pr.ProcName):INTEGER;
  32. VAR
  33.   i:INTEGER;
  34.   hash:LONGINT;
  35. BEGIN
  36.   i := 0;
  37.   hash := 0;
  38.   WHILE (i < pr.ProcNameLen) AND (proc[i] # as.nul) DO
  39.     (* $OvflChk- *)
  40.     hash := hash * 3 + ORD(proc[i]);
  41.     (* $OvflChk= *)
  42.     INC(i);
  43.   END; (* WHILE *)
  44.   IF hash = -32768 THEN
  45.     hash := 0;
  46.   ELSIF hash < 0 THEN
  47.     hash := -hash;
  48.   END; (* IF *)
  49.   RETURN SHORT(hash MOD pr.HashTableSize);
  50. END HashValue;
  51.  
  52. (* -------------------------------------------------------------------------- *)
  53.  
  54. (* StackChk+ *)
  55. PROCEDURE ExamineText;
  56. VAR
  57.   node:l.NodePtr;
  58.   prev:l.NodePtr;
  59.   type:INTEGER;
  60.   str:pr.ProcName;
  61.  
  62.   PROCEDURE ModifyImport;
  63.   VAR
  64.     node:l.NodePtr;
  65.     type:INTEGER;
  66.     str:pr.ProcName;
  67.     ok:BOOLEAN;
  68.   BEGIN
  69.     node := l.Head(te.ExList);
  70.     IF te.FindKeyWord({te.import},node,type) THEN
  71.       str := " prof:ProfRunTime,";
  72.       te.AddExpression(str,node,FALSE);
  73.     ELSIF te.FindKeyWord({te.module},node,type) THEN
  74.       WHILE (node # NIL) AND
  75.             ( ((node IS te.MaxExNode) AND ~node(te.MaxExNode).semicolon) OR
  76.               ((node IS te.MinExNode) AND ~node(te.MinExNode).semicolon)
  77.             ) DO
  78.         ok := l.Next(node);
  79.       END; (* WHILE *)
  80.       IF node # NIL THEN
  81.         str := "\nIMPORT prof:ProfRunTime;\n\n";
  82.         te.AddExpression(str,node,TRUE);
  83.       END; (* IF *)
  84.     ELSE
  85.       pr.Assert(FALSE,"Format-error in sourcecode");
  86.     END; (* IF *)
  87.   END ModifyImport;
  88.  
  89.   PROCEDURE AddEntryExit(scope:pr.ProcName;key:INTEGER):BOOLEAN;
  90.   VAR
  91.     found:INTEGER;
  92.     newScope:pr.ProcName;
  93.     function:BOOLEAN;
  94.     noBody:BOOLEAN;
  95.     ok:BOOLEAN;
  96.     ch:CHAR;
  97.  
  98.     PROCEDURE SetNewScope;
  99.     VAR
  100.       exPtr:CHARPtr;
  101.       i,end:INTEGER;
  102.       ok:BOOLEAN;
  103.     BEGIN
  104.       ok := l.Next(node);
  105.       i := st.Length(newScope);
  106.       IF node^ IS te.MaxExNode THEN
  107.         exPtr := s.VAL(CHARPtr,node(te.MaxExNode).expression);
  108.         end := i + node^(te.MaxExNode).len;
  109.       ELSE
  110.         exPtr := s.ADR(node^(te.MinExNode).expression);
  111.         end := i + node^(te.MinExNode).len;
  112.       END; (* IF *)
  113.       IF i > 0 THEN
  114.         newScope[i] := '.';
  115.         INC(i);
  116.       END; (* IF *)
  117.       WHILE ex.IsASCII(exPtr^) AND (i < end) AND (i < pr.ProcNameLen-1) DO
  118.         newScope[i] := exPtr^;
  119.         INC(i);
  120.         INC(exPtr);
  121.       END; (* WHILE *)
  122.       newScope[i] := as.nul;
  123.     END SetNewScope;
  124.  
  125.     PROCEDURE Prev(node:l.NodePtr):l.NodePtr;
  126.     VAR
  127.       ok:BOOLEAN;
  128.     BEGIN
  129.       ok := l.Previous(node);
  130.       RETURN node;
  131.     END Prev;
  132.  
  133.     PROCEDURE GetLastChar(node:l.NodePtr):CHAR;
  134.     VAR
  135.       i:INTEGER;
  136.       p:ex.MaxExpressionPtr;
  137.     BEGIN
  138.       IF node IS te.MaxExNode THEN
  139.         p := node(te.MaxExNode).expression;
  140.       ELSE
  141.         p := s.ADR(node(te.MinExNode).expression);
  142.       END; (* IF *)
  143.       i := st.Length(p^)-1;
  144.       WHILE (i >= 0) AND (p[i] = ' ') DO
  145.         DEC(i);
  146.       END; (* WHILE *)
  147.       IF i >= 0 THEN
  148.         RETURN p[i];
  149.       ELSE
  150.         RETURN ' ';
  151.       END; (* IF *)
  152.     END GetLastChar;
  153.  
  154.   BEGIN
  155.     IF DEBUG THEN
  156.       p.Printf1("AddEntryExit <%s>\n",s.ADR(scope));
  157.     END; (* IF *)
  158.     ok := l.Next(node);
  159.  
  160.     newScope := scope;
  161.     function := FALSE;
  162.     noBody := TRUE;
  163.  
  164.     WHILE te.FindKeyWord({te.end..te.halt},node,found) DO
  165.       CASE found OF
  166.        |te.begin:
  167.           IF (trace # 0) AND (key = te.module) THEN
  168.             p.SPrintf1(str,"prof.Trace := %ld;\n",trace);
  169.             te.AddExpression(str,node,TRUE);
  170.             ok := l.Next(node);
  171.           END; (* IF *)
  172.           p.SPrintf2(str,'prof.Entry("%s",%ld);\n',s.ADR(newScope),HashValue(newScope));
  173.           te.AddExpression(str,node,TRUE);
  174.           function := FALSE;
  175.           noBody := FALSE;
  176.        |te.end:
  177.           IF ((key = te.procedure) OR (key = te.module)) AND ~function AND ~noBody THEN
  178.             prev := Prev(node);
  179.             IF ((prev^ IS te.MaxExNode) AND ~prev^(te.MaxExNode).semicolon ) OR
  180.                ((prev^ IS te.MinExNode) AND ~prev^(te.MinExNode).semicolon ) THEN
  181.               te.AddExpression(";\n",prev,TRUE);
  182.             END; (* IF *)
  183.             p.SPrintf2(str,'prof.Exit("%s",%ld);\n',s.ADR(newScope),HashValue(newScope));
  184.             te.AddExpression(str,Prev(node),TRUE);
  185.           END; (* IF *)
  186.           RETURN function;
  187.        |te.return:
  188.           p.SPrintf2(str,'prof.Exit("%s",%ld);\n',s.ADR(newScope),HashValue(newScope));
  189.           te.AddExpression(str,Prev(node),TRUE);
  190.           function := TRUE;
  191.        |te.halt:
  192.           te.AddExpression("prof.Halt;\n",Prev(node),TRUE);
  193.        |te.procedure,te.module:
  194.           ch := GetLastChar(node);
  195.           IF ch # '^' THEN
  196.             prev := Prev(node);
  197.             ch := GetLastChar(prev);
  198.             IF (ch # '=') AND (ch # ':') THEN
  199.               SetNewScope;
  200.               function := AddEntryExit(newScope,found);
  201.               noBody := TRUE;
  202.               newScope := scope;
  203.             END; (* IF *)
  204.           END; (* IF *)
  205.        |te.if..te.loop:
  206.           function := AddEntryExit(newScope,found);
  207.           newScope := scope;
  208.        |te.close:
  209.           IF ~noBody THEN
  210.             p.SPrintf2(str,'prof.Exit("%s",%ld);\n',s.ADR(newScope),HashValue(newScope));
  211.             te.AddExpression(str,Prev(node),TRUE);
  212.             function := TRUE;
  213.           END; (* IF *)
  214.       ELSE (* te.import *)
  215.       END; (* CASE *)
  216.       ok := l.Next(node);
  217.     END; (* WHILE *)
  218.     RETURN function;
  219.   END AddEntryExit;
  220.  
  221. BEGIN
  222.   p.SPrintf0(str,"(* OProf \xA91990 by Volker Rudolph *)\n\n");
  223.   te.AddExpression(str,NIL,FALSE);
  224.  
  225.   ModifyImport;
  226.  
  227.   node  := l.Head(te.ExList);
  228.   str := "";
  229.   IF AddEntryExit(str,-1) THEN END;
  230. END ExamineText;
  231. (* StackChk= *)
  232.  
  233. (* -------------------------------------------------------------------------- *)
  234.  
  235. PROCEDURE WriteProf(name:ARRAY OF CHAR);
  236. BEGIN
  237.   IF te.ReadText(name) THEN
  238.     ExamineText;
  239.     pr.Assert(te.WriteText(),"WRITE ERROR");
  240.     te.RemText;
  241.   ELSE
  242.     p.Printf0("DISK ERROR\n");
  243.   END; (* IF *)
  244. END WriteProf;
  245.  
  246. (* -------------------------------------------------------------------------- *)
  247.  
  248. PROCEDURE DoArgs;
  249. VAR
  250.   i:INTEGER;
  251.   num:INTEGER;
  252.   len:INTEGER;
  253.   arg:ex.String;
  254.   arg2:ex.String;
  255. BEGIN
  256.   p.Printf0("OProf 1.22 \XA91990 by Volker Rudolph\n\n");
  257.   num := a.NumArgs();
  258.   IF num = 0 THEN
  259.     a.GetArg(0,arg);
  260.     p.Printf1("Usage:\n  %s Files/...,TRACE/S,TRACE2/S\n",s.ADR(arg));
  261.   END; (* IF *)
  262.   i := 1;
  263.   WHILE i <= num DO
  264.     a.GetArg(i,arg);
  265.     st.Upper(arg);
  266.     IF arg = "TRACE" THEN
  267.       trace := 1;
  268.     ELSIF arg = "TRACE2" THEN
  269.       trace := 2;
  270.     ELSIF arg = "?" THEN
  271.       a.GetArg(0,arg);
  272.       p.Printf1("Usage:\n  %s Files/...,TRACE/S,TRACE2/S\n",s.ADR(arg));
  273.       HALT(0);
  274.     END; (* IF *)
  275.     INC(i);
  276.   END; (* WHILE *)
  277.  
  278.   i := 1;
  279.   WHILE i <= num DO
  280.     a.GetArg(i,arg);
  281.     arg2 := arg;
  282.     st.Upper(arg2);
  283.     IF (arg2 # "TRACE") AND (arg2 # "TRACE2") THEN
  284.       len := st.Length(arg);
  285.       IF (len > 3) AND (st.Occurs(arg2,".MOD") = len-4) THEN
  286.         arg[len-4] := as.nul;
  287.         WriteProf(arg);
  288.       ELSE
  289.         WriteProf(arg);
  290.       END; (* IF *)
  291.     END; (* IF *)
  292.     INC(i);
  293.   END; (* WHILE *)
  294.   p.Printf0("\nReady.\n");
  295. END DoArgs;
  296.  
  297. (* -------------------------------------------------------------------------- *)
  298.  
  299. BEGIN
  300.   p.writeProc := io.WriteString;
  301.   pr.Quiet := TRUE;
  302.   trace := 0;
  303.   DoArgs;
  304. END OProf.
  305.